home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
dbase
/
lib19.zip
/
SCREEN.PRG
< prev
next >
Wrap
Text File
|
1992-09-28
|
53KB
|
1,297 lines
*-------------------------------------------------------------------------------
*-- Program...: SCREEN.PRG
*-- Programmer: Ken Mayer (KENMAYER)
*-- Date......: 09/15/1992
*-- Notes.....: A few routines not left in PROC.PRG, these are not used as much
*-- by my own systems. See the file: README.TXT for details on how
*-- to use this library file.
*-------------------------------------------------------------------------------
FUNCTION Radio
*-------------------------------------------------------------------------------
*-- Programmer..: Ed Lafferty (GICHIN)
*-- Date........: 06/08/1992
*-- Notes.......: Routine to create and size a popup with radio buttons
*-- for choosing only one of up to four options. Pressing
*-- the <Space Bar> on an option turns it on or off.
*-- Pressing <Enter> chooses the selected option and leaves
*-- the routine.
*-- Written for.: dBase IV, 1.1
*-- Rev. History: 02/25/1992 - original procedure.
*-- 02/27/1992 -- Ken Mayer -- added option for color, but had
*-- to take number of choices back to 4 to do so. Minor
*-- alterations performed to add color choice ... and cleaning
*-- up after self ... (original cleared the screen first ...
*-- this version saves screen, restores back to it ...) Oh yeah,
*-- I turned it into a function, rather than a procedure, as well.
*-- Calls.......: CENTER Procedure in PROC.PRG
*-- SHADOW Procedure in PROC.PRG
*-- COLORBRK() Function in PROC.PRG
*-- Called by...: Any
*-- Usage.......: Radio(<nULRow>,<nULCol>,<nChoice>,"<cTxt1>","<cTxt2>",;
*-- "<cTxt3>","<cTxt4>","<cTitle>","<cColor>")
*-- Example.....: cPort = Radio(8,15,1,"LPT1","LPT2","LPT3","",;
*-- "Choose a printer port","rg+/gb,n/w,rg+/gb")
*-- Returns.....: number of chosen button in nChoice
*-- Parameters..: nUlrow = upper left row of popup
*-- nUlcol = upper left column of popup
*-- nChoice = default chosen button
*-- cTxt1 = Text for 1st button
*-- cTxt2 = " " 2nd "
*-- cTxt3 = " " 3rd "
*-- cTxt4 = " " 4th "
*-- cTitle = Text for the box title
*-- cColor = Color string (i.e., "RG+/GB,N/W,RG+/GB")
*-------------------------------------------------------------------------------
parameters nUlrow, nUlcol, nChoice, cTxt1, cTxt2, cTxt3, cTxt4, ;
cTitle, cColor
private nHeight, nKey, nCnt, nWidth, cStr, cTxt0, cMidCol, cFirstCol,;
cCursor
cCursor = set("CURSOR")
store cTitle to cTxt0
save screen to sRadio
store 0 to nHeight, nKey, nCnt, nWidth
store nChoice to nOrig && in case user presses <Esc> to exit ...
*-- deal with these colors in displaying some stuff ...
cMidCol = colorbrk(cColor,2)
*-- First color (for message) is easier ...
cFirstCol = colorbrk(cColor,1)
*-- Determine height and width of popup
do case
case len(cTxt4) > 0
nHeight = 4
case len(cTxt3) > 0
nHeight = 3
case len(cTxt2) > 0
nHeight = 2
otherwise
nHeight = 1
endcase
do while nCnt <=nHeight
store "cTxt"+str(nCnt,1) to cStr
if len(&cstr) > nWidth
nWidth = len(&cStr)
endif
nCnt = nCnt + 1
enddo
*-- create popup
define window wRadio from nUlRow,nUlCol to nUlRow+nHeight+3,nUlCol+nWidth+9;
double color &cColor
do center with 23,80,"&cFirstCol","Press "+chr(24)+chr(25)+;
", <Space> to select/de-select, <Enter> to quit"
activate screen
do shadow with nULRow, nULCol, nULRow+nHeight+3, nULCol+nWidth+9
activate window wRadio
*-- display screen
store 1 to nCnt
do center with 0, nWidth+8, "", cTitle
do while nCnt <= nHeight
store "cTxt"+str(nCnt,1) to cStr
@ nCnt+1, 2 SAY "[ ]" color &cMidCol
@ nCnt+1, 6 say &cStr
nCnt = nCnt + 1
enddo
*-- prepare for and get nChoice
if nChoice > 0
store nChoice to nCnt
@nCnt+1,3 say "■" color &cMidCol
else
store 1 to nCnt
endif
store .F. to ldone
*-- this loop processes user input ...
do while .not. ldone
@ nCnt+1,3 say "" color &cMidCol
nkey = inkey(0)
do case
case nkey = 27 && Press Esc to exit
store nOrig to nChoice && Leave at "default"
store .T. to ldone
case nkey = 13
store .T. to ldone
case nkey = 32 && Press Enter or Space
set cursor off
if nChoice = nCnt
@ nCnt+1,3 say " " color &cMidCol
store 0 to nChoice
else
@ nChoice+1,3 say " " color &cMidCol
@ nCnt+1,3 say "■" color &cMidCol
store nCnt to nChoice
endif
set cursor on
case nkey = 5 && Press up arrow
if nCnt > 1
nCnt = nCnt - 1
else
nCnt = nHeight
endif
case nkey = 24 && Press down arrow
if nCnt < nHeight
nCnt = nCnt + 1
else
nCnt = 1
endif
endcase
enddo
*-- cleanup
deact window wRadio
release window wRadio
restore screen from sRadio
release screen sRadio
set message to
set cursor &cCursor
RETURN nChoice
*-- EoF: Radio()
PROCEDURE CheckBox
*-------------------------------------------------------------------------------
*-- Programmer..: Ed Lafferty (GICHIN)
*-- Date........: 02/28/1992
*-- Notes.......: Routine to create and size a popup with check boxes
*-- for choosing any of a number (up to five) options. Pressing
*-- the <Space Bar> on an option turns it on or off.
*-- Pressing <Enter> chooses the selected option and leaves
*-- the routine. You must use a data structure with logical
*-- fields, or memvars that are logical for this. Either way,
*-- even if you don't use five logical fields/memvars, you must
*-- pass a field/memvar to the procedure -- see Example below
*-- (the logicals -- lCHK1, lCHK2, etc.-- must be fields or
*-- memvars due to a limitation in parameter passing in dBASE IV.)
*-- Written for.: dBase IV, Version 1.1
*-- Rev. History: 02/25/1992 - original procedure.
*-- 02/28/1992 -- Ken Mayer -- modified to allow passing cColor,
*-- and a little cleanup of code and such. Minor changes.
*-- Calls.......: CENTER Procedure in PROC.PRG
*-- SHADOW Procedure in PROC.PRG
*-- COLORBRK() Function in PROC.PRG
*-- Called by...: Any
*-- Usage.......: do checkbox with <nULCol>,<nULRow>,<lchk1>,<lchk2>,<lchk3>,;
*-- <lchk4>,"<cTxt1>","<cTxt2>","<cTxt2>",;
*-- "<cTxt3>","<cTxt4>","<cTxt0>","<cColor>"
*-- Example.....: do Checkbox with 8, 15, lchk1, lchk2, lchk3, lchk4,;
*-- "LPT1", "LPT2", "LPT3","","Choose a printer port",;
*-- "rg+/gb,w+/n,rg+/gb"
*-- Returns.....: .T. for selected items, .F. for non-selected items --
*-- this routine changes the value of the logical fields passed
*-- to it.
*-- Parameters..: nULRow = upper left row of popup
*-- nULCol = upper left column of popup
*-- lChkn = default value of box 'n' -- MUST BE FIELDS/MEMVARS
*-- cTxt1 = Text for 1st box
*-- cTxt2 = " " 2nd "
*-- cTxt3 = " " 3rd "
*-- cTxt4 = " " 4th "
*-- cTxt0 = Text for the box title
*-- cColor = Colors to be used in window ...
*-------------------------------------------------------------------------------
parameters nUlrow, nUlcol, lChk1, lChk2, lChk3, lChk4, ;
cTxt1, cTxt2, cTxt3, cTxt4, cTxt0, cColor
private nHeight, nKey, nCnt, nWidth, lOrig1, lO